home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / cmds / perl / dist / stab.c < prev    next >
C/C++ Source or Header  |  1991-11-14  |  23KB  |  1,010 lines
  1. /* $RCSfile: stab.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:35:33 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    stab.c,v $
  9.  * Revision 4.0.1.3  91/11/05  18:35:33  lwall
  10.  * patch11: length($x) was sometimes wrong for numeric $x
  11.  * patch11: perl now issues warning if $SIG{'ALARM'} is referenced
  12.  * patch11: *foo = undef coredumped
  13.  * patch11: solitary subroutine references no longer trigger typo warnings
  14.  * patch11: local(*FILEHANDLE) had a memory leak
  15.  * 
  16.  * Revision 4.0.1.2  91/06/07  11:55:53  lwall
  17.  * patch4: new copyright notice
  18.  * patch4: added $^P variable to control calling of perldb routines
  19.  * patch4: added $^F variable to specify maximum system fd, default 2
  20.  * patch4: $` was busted inside s///
  21.  * patch4: default top-of-form format is now FILEHANDLE_TOP
  22.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  23.  * patch4: $^D |= 1024 now does syntax tree dump at run-time
  24.  * 
  25.  * Revision 4.0.1.1  91/04/12  09:10:24  lwall
  26.  * patch1: Configure now differentiates getgroups() type from getgid() type
  27.  * patch1: you may now use "die" and "caller" in a signal handler
  28.  * 
  29.  * Revision 4.0  91/03/20  01:39:41  lwall
  30.  * 4.0 baseline.
  31.  * 
  32.  */
  33.  
  34. #include "EXTERN.h"
  35. #include "perl.h"
  36.  
  37. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  38. #include <signal.h>
  39. #endif
  40.  
  41. static char *sig_name[] = {
  42.     SIG_NAME,0
  43. };
  44.  
  45. #ifdef VOIDSIG
  46. #define handlertype void
  47. #else
  48. #define handlertype int
  49. #endif
  50.  
  51. static handlertype sighandler();
  52.  
  53. static int origalen = 0;
  54.  
  55. STR *
  56. stab_str(str)
  57. STR *str;
  58. {
  59.     STAB *stab = str->str_u.str_stab;
  60.     register int paren;
  61.     register char *s;
  62.     register int i;
  63.  
  64.     if (str->str_rare)
  65.     return stab_val(stab);
  66.  
  67.     switch (*stab->str_magic->str_ptr) {
  68.     case '\004':        /* ^D */
  69. #ifdef DEBUGGING
  70.     str_numset(stab_val(stab),(double)(debug & 32767));
  71. #endif
  72.     break;
  73.     case '\006':        /* ^F */
  74.     str_numset(stab_val(stab),(double)maxsysfd);
  75.     break;
  76.     case '\t':            /* ^I */
  77.     if (inplace)
  78.         str_set(stab_val(stab), inplace);
  79.     else
  80.         str_sset(stab_val(stab),&str_undef);
  81.     break;
  82.     case '\020':        /* ^P */
  83.     str_numset(stab_val(stab),(double)perldb);
  84.     break;
  85.     case '\024':        /* ^T */
  86.     str_numset(stab_val(stab),(double)basetime);
  87.     break;
  88.     case '\027':        /* ^W */
  89.     str_numset(stab_val(stab),(double)dowarn);
  90.     break;
  91.     case '1': case '2': case '3': case '4':
  92.     case '5': case '6': case '7': case '8': case '9': case '&':
  93.     if (curspat) {
  94.         paren = atoi(stab_name(stab));
  95.       getparen:
  96.         if (curspat->spat_regexp &&
  97.           paren <= curspat->spat_regexp->nparens &&
  98.           (s = curspat->spat_regexp->startp[paren]) ) {
  99.         i = curspat->spat_regexp->endp[paren] - s;
  100.         if (i >= 0)
  101.             str_nset(stab_val(stab),s,i);
  102.         else
  103.             str_sset(stab_val(stab),&str_undef);
  104.         }
  105.         else
  106.         str_sset(stab_val(stab),&str_undef);
  107.     }
  108.     break;
  109.     case '+':
  110.     if (curspat) {
  111.         paren = curspat->spat_regexp->lastparen;
  112.         goto getparen;
  113.     }
  114.     break;
  115.     case '`':
  116.     if (curspat) {
  117.         if (curspat->spat_regexp &&
  118.           (s = curspat->spat_regexp->subbeg) ) {
  119.         i = curspat->spat_regexp->startp[0] - s;
  120.         if (i >= 0)
  121.             str_nset(stab_val(stab),s,i);
  122.         else
  123.             str_nset(stab_val(stab),"",0);
  124.         }
  125.         else
  126.         str_nset(stab_val(stab),"",0);
  127.     }
  128.     break;
  129.     case '\'':
  130.     if (curspat) {
  131.         if (curspat->spat_regexp &&
  132.           (s = curspat->spat_regexp->endp[0]) ) {
  133.         str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
  134.         }
  135.         else
  136.         str_nset(stab_val(stab),"",0);
  137.     }
  138.     break;
  139.     case '.':
  140. #ifndef lint
  141.     if (last_in_stab) {
  142.         str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
  143.     }
  144. #endif
  145.     break;
  146.     case '?':
  147.     str_numset(stab_val(stab),(double)statusvalue);
  148.     break;
  149.     case '^':
  150.     s = stab_io(curoutstab)->top_name;
  151.     if (s)
  152.         str_set(stab_val(stab),s);
  153.     else {
  154.         str_set(stab_val(stab),stab_name(curoutstab));
  155.         str_cat(stab_val(stab),"_TOP");
  156.     }
  157.     break;
  158.     case '~':
  159.     s = stab_io(curoutstab)->fmt_name;
  160.     if (!s)
  161.         s = stab_name(curoutstab);
  162.     str_set(stab_val(stab),s);
  163.     break;
  164. #ifndef lint
  165.     case '=':
  166.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
  167.     break;
  168.     case '-':
  169.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
  170.     break;
  171.     case '%':
  172.     str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
  173.     break;
  174. #endif
  175.     case '/':
  176.     break;
  177.     case '[':
  178.     str_numset(stab_val(stab),(double)arybase);
  179.     break;
  180.     case '|':
  181.     if (!stab_io(curoutstab))
  182.         stab_io(curoutstab) = stio_new();
  183.     str_numset(stab_val(stab),
  184.        (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
  185.     break;
  186.     case ',':
  187.     str_nset(stab_val(stab),ofs,ofslen);
  188.     break;
  189.     case '\\':
  190.     str_nset(stab_val(stab),ors,orslen);
  191.     break;
  192.     case '#':
  193.     str_set(stab_val(stab),ofmt);
  194.     break;
  195.     case '!':
  196.     str_numset(stab_val(stab), (double)errno);
  197.     str_set(stab_val(stab), errno ? strerror(errno) : "");
  198.     stab_val(stab)->str_nok = 1;    /* what a wonderful hack! */
  199.     break;
  200.     case '<':
  201.     str_numset(stab_val(stab),(double)uid);
  202.     break;
  203.     case '>':
  204.     str_numset(stab_val(stab),(double)euid);
  205.     break;
  206.     case '(':
  207.     s = buf;
  208.     (void)sprintf(s,"%d",(int)gid);
  209.     goto add_groups;
  210.     case ')':
  211.     s = buf;
  212.     (void)sprintf(s,"%d",(int)egid);
  213.       add_groups:
  214.     while (*s) s++;
  215. #ifdef HAS_GETGROUPS
  216. #ifndef NGROUPS
  217. #define NGROUPS 32
  218. #endif
  219.     {
  220.         GROUPSTYPE gary[NGROUPS];
  221.  
  222.         i = getgroups(NGROUPS,gary);
  223.         while (--i >= 0) {
  224.         (void)sprintf(s," %ld", (long)gary[i]);
  225.         while (*s) s++;
  226.         }
  227.     }
  228. #endif
  229.     str_set(stab_val(stab),buf);
  230.     break;
  231.     case '*':
  232.     break;
  233.     case '0':
  234.     break;
  235.     default:
  236.     {
  237.         struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
  238.  
  239.         if (uf && uf->uf_val)
  240.         (*uf->uf_val)(uf->uf_index, stab_val(stab));
  241.     }
  242.     break;
  243.     }
  244.     return stab_val(stab);
  245. }
  246.  
  247. STRLEN
  248. stab_len(str)
  249. STR *str;
  250. {
  251.     STAB *stab = str->str_u.str_stab;
  252.     int paren;
  253.     int i;
  254.     char *s;
  255.  
  256.     if (str->str_rare)
  257.     return str_len(stab_val(stab));
  258.  
  259.     switch (*stab->str_magic->str_ptr) {
  260.     case '1': case '2': case '3': case '4':
  261.     case '5': case '6': case '7': case '8': case '9': case '&':
  262.     if (curspat) {
  263.         paren = atoi(stab_name(stab));
  264.       getparen:
  265.         if (curspat->spat_regexp &&
  266.           paren <= curspat->spat_regexp->nparens &&
  267.           (s = curspat->spat_regexp->startp[paren]) ) {
  268.         i = curspat->spat_regexp->endp[paren] - s;
  269.         if (i >= 0)
  270.             return i;
  271.         else
  272.             return 0;
  273.         }
  274.         else
  275.         return 0;
  276.     }
  277.     break;
  278.     case '+':
  279.     if (curspat) {
  280.         paren = curspat->spat_regexp->lastparen;
  281.         goto getparen;
  282.     }
  283.     break;
  284.     case '`':
  285.     if (curspat) {
  286.         if (curspat->spat_regexp &&
  287.           (s = curspat->spat_regexp->subbeg) ) {
  288.         i = curspat->spat_regexp->startp[0] - s;
  289.         if (i >= 0)
  290.             return i;
  291.         else
  292.             return 0;
  293.         }
  294.         else
  295.         return 0;
  296.     }
  297.     break;
  298.     case '\'':
  299.     if (curspat) {
  300.         if (curspat->spat_regexp &&
  301.           (s = curspat->spat_regexp->endp[0]) ) {
  302.         return (STRLEN) (curspat->spat_regexp->subend - s);
  303.         }
  304.         else
  305.         return 0;
  306.     }
  307.     break;
  308.     case ',':
  309.     return (STRLEN)ofslen;
  310.     case '\\':
  311.     return (STRLEN)orslen;
  312.     default:
  313.     return str_len(stab_str(str));
  314.     }
  315. }
  316.  
  317. stabset(mstr,str)
  318. register STR *mstr;
  319. STR *str;
  320. {
  321.     STAB *stab;
  322.     register char *s;
  323.     int i;
  324.  
  325.     switch (mstr->str_rare) {
  326.     case 'E':
  327.     setenv(mstr->str_ptr,str_get(str));
  328.                 /* And you'll never guess what the dog had */
  329.                 /*   in its mouth... */
  330. #ifdef TAINT
  331.     if (strEQ(mstr->str_ptr,"PATH")) {
  332.         char *strend = str->str_ptr + str->str_cur;
  333.  
  334.         s = str->str_ptr;
  335.         while (s < strend) {
  336.         s = cpytill(tokenbuf,s,strend,':',&i);
  337.         s++;
  338.         if (*tokenbuf != '/'
  339.           || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  340.             str->str_tainted = 2;
  341.         }
  342.     }
  343. #endif
  344.     break;
  345.     case 'S':
  346.     s = str_get(str);
  347.     i = whichsig(mstr->str_ptr);    /* ...no, a brick */
  348.     if (!i && (dowarn || strEQ(mstr->str_ptr,"ALARM")))
  349.         warn("No such signal: SIG%s", mstr->str_ptr);
  350.     if (strEQ(s,"IGNORE"))
  351. #ifndef lint
  352.         (void)signal(i,SIG_IGN);
  353. #else
  354.         ;
  355. #endif
  356.     else if (strEQ(s,"DEFAULT") || !*s)
  357.         (void)signal(i,SIG_DFL);
  358.     else {
  359.         (void)signal(i,sighandler);
  360.         if (!index(s,'\'')) {
  361.         sprintf(tokenbuf, "main'%s",s);
  362.         str_set(str,tokenbuf);
  363.         }
  364.     }
  365.     break;
  366. #ifdef SOME_DBM
  367.     case 'D':
  368.     stab = mstr->str_u.str_stab;
  369.     hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
  370.     break;
  371. #endif
  372.     case 'L':
  373.     {
  374.         CMD *cmd;
  375.  
  376.         stab = mstr->str_u.str_stab;
  377.         i = str_true(str);
  378.         str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
  379.         cmd = str->str_magic->str_u.str_cmd;
  380.         cmd->c_flags &= ~CF_OPTIMIZE;
  381.         cmd->c_flags |= i? CFT_D1 : CFT_D0;
  382.     }
  383.     break;
  384.     case '#':
  385.     stab = mstr->str_u.str_stab;
  386.     afill(stab_array(stab), (int)str_gnum(str) - arybase);
  387.     break;
  388.     case 'X':    /* merely a copy of a * string */
  389.     break;
  390.     case '*':
  391.     s = str->str_pok ? str_get(str) : "";
  392.     if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) {
  393.         stab = mstr->str_u.str_stab;
  394.         if (!*s) {
  395.         STBP *stbp;
  396.  
  397.         /*SUPPRESS 701*/
  398.         (void)savenostab(stab);    /* schedule a free of this stab */
  399.         if (stab->str_len)
  400.             Safefree(stab->str_ptr);
  401.         Newz(601,stbp, 1, STBP);
  402.         stab->str_ptr = stbp;
  403.         stab->str_len = stab->str_cur = sizeof(STBP);
  404.         stab->str_pok = 1;
  405.         strcpy(stab_magic(stab),"StB");
  406.         stab_val(stab) = Str_new(70,0);
  407.         stab_line(stab) = curcmd->c_line;
  408.         stab_stash(stab) = curcmd->c_stash;
  409.         }
  410.         else {
  411.         stab = stabent(s,TRUE);
  412.         if (!stab_xarray(stab))
  413.             aadd(stab);
  414.         if (!stab_xhash(stab))
  415.             hadd(stab);
  416.         if (!stab_io(stab))
  417.             stab_io(stab) = stio_new();
  418.         }
  419.         str_sset(str, (STR*) stab);
  420.     }
  421.     break;
  422.     case 's': {
  423.         struct lstring *lstr = (struct lstring*)str;
  424.         char *tmps;
  425.  
  426.         mstr->str_rare = 0;
  427.         str->str_magic = Nullstr;
  428.         tmps = str_get(str);
  429.         str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
  430.           tmps,str->str_cur);
  431.     }
  432.     break;
  433.  
  434.     case 'v':
  435.     do_vecset(mstr,str);
  436.     break;
  437.  
  438.     case 0:
  439.     /*SUPPRESS 560*/
  440.     if (!(stab = mstr->str_u.str_stab))
  441.         break;
  442.     switch (*stab->str_magic->str_ptr) {
  443.     case '\004':    /* ^D */
  444. #ifdef DEBUGGING
  445.         debug = (int)(str_gnum(str)) | 32768;
  446.         if (debug & 1024)
  447.         dump_all();
  448. #endif
  449.         break;
  450.     case '\006':    /* ^F */
  451.         maxsysfd = (int)str_gnum(str);
  452.         break;
  453.     case '\t':    /* ^I */
  454.         if (inplace)
  455.         Safefree(inplace);
  456.         if (str->str_pok || str->str_nok)
  457.         inplace = savestr(str_get(str));
  458.         else
  459.         inplace = Nullch;
  460.         break;
  461.     case '\020':    /* ^P */
  462.         perldb = (int)str_gnum(str);
  463.         break;
  464.     case '\024':    /* ^T */
  465.         basetime = (long)str_gnum(str);
  466.         break;
  467.     case '\027':    /* ^W */
  468.         dowarn = (bool)str_gnum(str);
  469.         break;
  470.     case '.':
  471.         if (localizing)
  472.         savesptr((STR**)&last_in_stab);
  473.         break;
  474.     case '^':
  475.         Safefree(stab_io(curoutstab)->top_name);
  476.         stab_io(curoutstab)->top_name = s = savestr(str_get(str));
  477.         stab_io(curoutstab)->top_stab = stabent(s,TRUE);
  478.         break;
  479.     case '~':
  480.         Safefree(stab_io(curoutstab)->fmt_name);
  481.         stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
  482.         stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
  483.         break;
  484.     case '=':
  485.         stab_io(curoutstab)->page_len = (long)str_gnum(str);
  486.         break;
  487.     case '-':
  488.         stab_io(curoutstab)->lines_left = (long)str_gnum(str);
  489.         if (stab_io(curoutstab)->lines_left < 0L)
  490.         stab_io(curoutstab)->lines_left = 0L;
  491.         break;
  492.     case '%':
  493.         stab_io(curoutstab)->page = (long)str_gnum(str);
  494.         break;
  495.     case '|':
  496.         if (!stab_io(curoutstab))
  497.         stab_io(curoutstab) = stio_new();
  498.         stab_io(curoutstab)->flags &= ~IOF_FLUSH;
  499.         if (str_gnum(str) != 0.0) {
  500.         stab_io(curoutstab)->flags |= IOF_FLUSH;
  501.         }
  502.         break;
  503.     case '*':
  504.         i = (int)str_gnum(str);
  505.         multiline = (i != 0);
  506.         break;
  507.     case '/':
  508.         if (str->str_pok) {
  509.         rs = str_get(str);
  510.         rslen = str->str_cur;
  511.         if (!rslen) {
  512.             rs = "\n\n";
  513.             rslen = 2;
  514.         }
  515.         rschar = rs[rslen - 1];
  516.         }
  517.         else {
  518.         rschar = 0777;    /* fake a non-existent char */
  519.         rslen = 1;
  520.         }
  521.         break;
  522.     case '\\':
  523.         if (ors)
  524.         Safefree(ors);
  525.         ors = savestr(str_get(str));
  526.         orslen = str->str_cur;
  527.         break;
  528.     case ',':
  529.         if (ofs)
  530.         Safefree(ofs);
  531.         ofs = savestr(str_get(str));
  532.         ofslen = str->str_cur;
  533.         break;
  534.     case '#':
  535.         if (ofmt)
  536.         Safefree(ofmt);
  537.         ofmt = savestr(str_get(str));
  538.         break;
  539.     case '[':
  540.         arybase = (int)str_gnum(str);
  541.         break;
  542.     case '?':
  543.         statusvalue = U_S(str_gnum(str));
  544.         break;
  545.     case '!':
  546.         errno = (int)str_gnum(str);        /* will anyone ever use this? */
  547.         break;
  548.     case '<':
  549.         uid = (int)str_gnum(str);
  550. #if defined(HAS_SETREUID) || !defined(HAS_SETRUID)
  551.         if (delaymagic) {
  552.         delaymagic |= DM_REUID;
  553.         break;                /* don't do magic till later */
  554.         }
  555. #endif /* HAS_SETREUID or not HASSETRUID */
  556. #ifdef HAS_SETRUID
  557.         if (setruid((UIDTYPE)uid) < 0)
  558.         uid = (int)getuid();
  559. #else
  560. #ifdef HAS_SETREUID
  561.         if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
  562.         uid = (int)getuid();
  563. #else
  564.         if (uid == euid)        /* special case $< = $> */
  565.         setuid(uid);
  566.         else
  567.         fatal("setruid() not implemented");
  568. #endif
  569. #endif
  570.         break;
  571.     case '>':
  572.         euid = (int)str_gnum(str);
  573. #if defined(HAS_SETREUID) || !defined(HAS_SETEUID)
  574.         if (delaymagic) {
  575.         delaymagic |= DM_REUID;
  576.         break;                /* don't do magic till later */
  577.         }
  578. #endif /* HAS_SETREUID or not HAS_SETEUID */
  579. #ifdef HAS_SETEUID
  580.         if (seteuid((UIDTYPE)euid) < 0)
  581.         euid = (int)geteuid();
  582. #else
  583. #ifdef HAS_SETREUID
  584.         if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
  585.         euid = (int)geteuid();
  586. #else
  587.         if (euid == uid)        /* special case $> = $< */
  588.         setuid(euid);
  589.         else
  590.         fatal("seteuid() not implemented");
  591. #endif
  592. #endif
  593.         break;
  594.     case '(':
  595.         gid = (int)str_gnum(str);
  596. #if defined(HAS_SETREGID) || !defined(HAS_SETRGID)
  597.         if (delaymagic) {
  598.         delaymagic |= DM_REGID;
  599.         break;                /* don't do magic till later */
  600.         }
  601. #endif /* HAS_SETREGID or not HAS_SETRGID */
  602. #ifdef HAS_SETRGID
  603.         (void)setrgid((GIDTYPE)gid);
  604. #else
  605. #ifdef HAS_SETREGID
  606.         (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
  607. #else
  608.         fatal("setrgid() not implemented");
  609. #endif
  610. #endif
  611.         break;
  612.     case ')':
  613.         egid = (int)str_gnum(str);
  614. #if defined(HAS_SETREGID) || !defined(HAS_SETEGID)
  615.         if (delaymagic) {
  616.         delaymagic |= DM_REGID;
  617.         break;                /* don't do magic till later */
  618.         }
  619. #endif /* HAS_SETREGID or not HAS_SETEGID */
  620. #ifdef HAS_SETEGID
  621.         (void)setegid((GIDTYPE)egid);
  622. #else
  623. #ifdef HAS_SETREGID
  624.         (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
  625. #else
  626.         fatal("setegid() not implemented");
  627. #endif
  628. #endif
  629.         break;
  630.     case ':':
  631.         chopset = str_get(str);
  632.         break;
  633.     case '0':
  634.         if (!origalen) {
  635.         s = origargv[0];
  636.         s += strlen(s);
  637.         /* See if all the arguments are contiguous in memory */
  638.         for (i = 1; i < origargc; i++) {
  639.             if (origargv[i] == s + 1)
  640.             s += strlen(++s);    /* this one is ok too */
  641.         }
  642.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  643.             setenv("NoNeSuCh", Nullch);    /* force copy of environment */
  644.             for (i = 0; origenviron[i]; i++)
  645.             if (origenviron[i] == s + 1)
  646.                 s += strlen(++s);
  647.         }
  648.         origalen = s - origargv[0];
  649.         }
  650.         s = str_get(str);
  651.         i = str->str_cur;
  652.         if (i >= origalen) {
  653.         i = origalen;
  654.         str->str_cur = i;
  655.         str->str_ptr[i] = '\0';
  656.         bcopy(s, origargv[0], i);
  657.         }
  658.         else {
  659.         bcopy(s, origargv[0], i);
  660.         s = origargv[0]+i;
  661.         *s++ = '\0';
  662.         while (++i < origalen)
  663.             *s++ = ' ';
  664.         }
  665.         break;
  666.     default:
  667.         {
  668.         struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
  669.  
  670.         if (uf && uf->uf_set)
  671.             (*uf->uf_set)(uf->uf_index, str);
  672.         }
  673.         break;
  674.     }
  675.     break;
  676.     }
  677. }
  678.  
  679. whichsig(sig)
  680. char *sig;
  681. {
  682.     register char **sigv;
  683.  
  684.     for (sigv = sig_name+1; *sigv; sigv++)
  685.     if (strEQ(sig,*sigv))
  686.         return sigv - sig_name;
  687. #ifdef SIGCLD
  688.     if (strEQ(sig,"CHLD"))
  689.     return SIGCLD;
  690. #endif
  691. #ifdef SIGCHLD
  692.     if (strEQ(sig,"CLD"))
  693.     return SIGCHLD;
  694. #endif
  695.     return 0;
  696. }
  697.  
  698. static handlertype
  699. sighandler(sig)
  700. int sig;
  701. {
  702.     STAB *stab;
  703.     STR *str;
  704.     int oldsave = savestack->ary_fill;
  705.     int oldtmps_base = tmps_base;
  706.     register CSV *csv;
  707.     SUBR *sub;
  708.  
  709. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  710.     signal(sig, SIG_ACK);
  711. #endif
  712.     stab = stabent(
  713.     str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
  714.       TRUE)), TRUE);
  715.     sub = stab_sub(stab);
  716.     if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
  717.     if (sig_name[sig][1] == 'H')
  718.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
  719.           TRUE);
  720.     else
  721.         stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
  722.           TRUE);
  723.     sub = stab_sub(stab);    /* gag */
  724.     }
  725.     if (!sub) {
  726.     if (dowarn)
  727.         warn("SIG%s handler \"%s\" not defined.\n",
  728.         sig_name[sig], stab_name(stab) );
  729.     return;
  730.     }
  731.     /*SUPPRESS 701*/
  732.     saveaptr(&stack);
  733.     str = Str_new(15, sizeof(CSV));
  734.     str->str_state = SS_SCSV;
  735.     (void)apush(savestack,str);
  736.     csv = (CSV*)str->str_ptr;
  737.     csv->sub = sub;
  738.     csv->stab = stab;
  739.     csv->curcsv = curcsv;
  740.     csv->curcmd = curcmd;
  741.     csv->depth = sub->depth;
  742.     csv->wantarray = G_SCALAR;
  743.     csv->hasargs = TRUE;
  744.     csv->savearray = stab_xarray(defstab);
  745.     csv->argarray = stab_xarray(defstab) = stack = anew(defstab);
  746.     stack->ary_flags = 0;
  747.     curcsv = csv;
  748.     str = str_mortal(&str_undef);
  749.     str_set(str,sig_name[sig]);
  750.     (void)apush(stab_xarray(defstab),str);
  751.     sub->depth++;
  752.     if (sub->depth >= 2) {    /* save temporaries on recursion? */
  753.     if (sub->depth == 100 && dowarn)
  754.         warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
  755.     savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
  756.     }
  757.  
  758.     tmps_base = tmps_max;        /* protect our mortal string */
  759.     (void)cmd_exec(sub->cmd,G_SCALAR,0);        /* so do it already */
  760.     tmps_base = oldtmps_base;
  761.  
  762.     restorelist(oldsave);        /* put everything back */
  763. }
  764.  
  765. STAB *
  766. aadd(stab)
  767. register STAB *stab;
  768. {
  769.     if (!stab_xarray(stab))
  770.     stab_xarray(stab) = anew(stab);
  771.     return stab;
  772. }
  773.  
  774. STAB *
  775. hadd(stab)
  776. register STAB *stab;
  777. {
  778.     if (!stab_xhash(stab))
  779.     stab_xhash(stab) = hnew(COEFFSIZE);
  780.     return stab;
  781. }
  782.  
  783. STAB *
  784. fstab(name)
  785. char *name;
  786. {
  787.     char tmpbuf[1200];
  788.     STAB *stab;
  789.  
  790.     sprintf(tmpbuf,"'_<%s", name);
  791.     stab = stabent(tmpbuf, TRUE);
  792.     str_set(stab_val(stab), name);
  793.     if (perldb)
  794.     (void)hadd(aadd(stab));
  795.     return stab;
  796. }
  797.  
  798. STAB *
  799. stabent(name,add)
  800. register char *name;
  801. int add;
  802. {
  803.     register STAB *stab;
  804.     register STBP *stbp;
  805.     int len;
  806.     register char *namend;
  807.     HASH *stash;
  808.     char *sawquote = Nullch;
  809.     char *prevquote = Nullch;
  810.     bool global = FALSE;
  811.  
  812.     if (isUPPER(*name)) {
  813.     if (*name > 'I') {
  814.         if (*name == 'S' && (
  815.           strEQ(name, "SIG") ||
  816.           strEQ(name, "STDIN") ||
  817.           strEQ(name, "STDOUT") ||
  818.           strEQ(name, "STDERR") ))
  819.         global = TRUE;
  820.     }
  821.     else if (*name > 'E') {
  822.         if (*name == 'I' && strEQ(name, "INC"))
  823.         global = TRUE;
  824.     }
  825.     else if (*name > 'A') {
  826.         if (*name == 'E' && strEQ(name, "ENV"))
  827.         global = TRUE;
  828.     }
  829.     else if (*name == 'A' && (
  830.       strEQ(name, "ARGV") ||
  831.       strEQ(name, "ARGVOUT") ))
  832.         global = TRUE;
  833.     }
  834.     for (namend = name; *namend; namend++) {
  835.     if (*namend == '\'' && namend[1])
  836.         prevquote = sawquote, sawquote = namend;
  837.     }
  838.     if (sawquote == name && name[1]) {
  839.     stash = defstash;
  840.     sawquote = Nullch;
  841.     name++;
  842.     }
  843.     else if (!isALPHA(*name) || global)
  844.     stash = defstash;
  845.     else if ((CMD*)curcmd == &compiling)
  846.     stash = curstash;
  847.     else
  848.     stash = curcmd->c_stash;
  849.     if (sawquote) {
  850.     char tmpbuf[256];
  851.     char *s, *d;
  852.  
  853.     *sawquote = '\0';
  854.     /*SUPPRESS 560*/
  855.     if (s = prevquote) {
  856.         strncpy(tmpbuf,name,s-name+1);
  857.         d = tmpbuf+(s-name+1);
  858.         *d++ = '_';
  859.         strcpy(d,s+1);
  860.     }
  861.     else {
  862.         *tmpbuf = '_';
  863.         strcpy(tmpbuf+1,name);
  864.     }
  865.     stab = stabent(tmpbuf,TRUE);
  866.     if (!(stash = stab_xhash(stab)))
  867.         stash = stab_xhash(stab) = hnew(0);
  868.     if (!stash->tbl_name)
  869.         stash->tbl_name = savestr(name);
  870.     name = sawquote+1;
  871.     *sawquote = '\'';
  872.     }
  873.     len = namend - name;
  874.     stab = (STAB*)hfetch(stash,name,len,add);
  875.     if (stab == (STAB*)&str_undef)
  876.     return Nullstab;
  877.     if (stab->str_pok) {
  878.     stab->str_pok |= SP_MULTI;
  879.     return stab;
  880.     }
  881.     else {
  882.     if (stab->str_len)
  883.         Safefree(stab->str_ptr);
  884.     Newz(602,stbp, 1, STBP);
  885.     stab->str_ptr = stbp;
  886.     stab->str_len = stab->str_cur = sizeof(STBP);
  887.     stab->str_pok = 1;
  888.     strcpy(stab_magic(stab),"StB");
  889.     stab_val(stab) = Str_new(72,0);
  890.     stab_line(stab) = curcmd->c_line;
  891.     str_magic((STR*)stab, stab, '*', name, len);
  892.     stab_stash(stab) = stash;
  893.     if (isDIGIT(*name) && *name != '0') {
  894.         stab_flags(stab) = SF_VMAGIC;
  895.         str_magic(stab_val(stab), stab, 0, Nullch, 0);
  896.     }
  897.     if (add & 2)
  898.         stab->str_pok |= SP_MULTI;
  899.     return stab;
  900.     }
  901. }
  902.  
  903. stab_fullname(str,stab)
  904. STR *str;
  905. STAB *stab;
  906. {
  907.     HASH *tb = stab_stash(stab);
  908.  
  909.     if (!tb)
  910.     return;
  911.     str_set(str,tb->tbl_name);
  912.     str_ncat(str,"'", 1);
  913.     str_scat(str,stab->str_magic);
  914. }
  915.  
  916. STIO *
  917. stio_new()
  918. {
  919.     STIO *stio;
  920.  
  921.     Newz(603,stio,1,STIO);
  922.     stio->page_len = 60;
  923.     return stio;
  924. }
  925.  
  926. stab_check(min,max)
  927. int min;
  928. register int max;
  929. {
  930.     register HENT *entry;
  931.     register int i;
  932.     register STAB *stab;
  933.  
  934.     for (i = min; i <= max; i++) {
  935.     for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
  936.         stab = (STAB*)entry->hent_val;
  937.         if (stab->str_pok & SP_MULTI)
  938.         continue;
  939.         curcmd->c_line = stab_line(stab);
  940.         warn("Possible typo: \"%s\"", stab_name(stab));
  941.     }
  942.     }
  943. }
  944.  
  945. static int gensym = 0;
  946.  
  947. STAB *
  948. genstab()
  949. {
  950.     (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
  951.     return stabent(tokenbuf,TRUE);
  952. }
  953.  
  954. /* hopefully this is only called on local symbol table entries */
  955.  
  956. void
  957. stab_clear(stab)
  958. register STAB *stab;
  959. {
  960.     STIO *stio;
  961.     SUBR *sub;
  962.  
  963.     afree(stab_xarray(stab));
  964.     stab_xarray(stab) = Null(ARRAY*);
  965.     (void)hfree(stab_xhash(stab), FALSE);
  966.     stab_xhash(stab) = Null(HASH*);
  967.     str_free(stab_val(stab));
  968.     stab_val(stab) = Nullstr;
  969.     /*SUPPRESS 560*/
  970.     if (stio = stab_io(stab)) {
  971.     do_close(stab,FALSE);
  972.     Safefree(stio->top_name);
  973.     Safefree(stio->fmt_name);
  974.     Safefree(stio);
  975.     }
  976.     /*SUPPRESS 560*/
  977.     if (sub = stab_sub(stab)) {
  978.     afree(sub->tosave);
  979.     cmd_free(sub->cmd);
  980.     }
  981.     Safefree(stab->str_ptr);
  982.     stab->str_ptr = Null(STBP*);
  983.     stab->str_len = 0;
  984.     stab->str_cur = 0;
  985. }
  986.  
  987. #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
  988. #define MICROPORT
  989. #endif
  990.  
  991. #ifdef    MICROPORT    /* Microport 2.4 hack */
  992. ARRAY *stab_array(stab)
  993. register STAB *stab;
  994. {
  995.     if (((STBP*)(stab->str_ptr))->stbp_array) 
  996.     return ((STBP*)(stab->str_ptr))->stbp_array;
  997.     else
  998.     return ((STBP*)(aadd(stab)->str_ptr))->stbp_array;
  999. }
  1000.  
  1001. HASH *stab_hash(stab)
  1002. register STAB *stab;
  1003. {
  1004.     if (((STBP*)(stab->str_ptr))->stbp_hash)
  1005.     return ((STBP*)(stab->str_ptr))->stbp_hash;
  1006.     else
  1007.     return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash;
  1008. }
  1009. #endif            /* Microport 2.4 hack */
  1010.